Progress Simulator Combines Features Developed by Others
This progress simulator doesn't bring something new to programming or coding in Liberty Basic. I just combined several features and code from others to realise my progress simulator.
Here is how I got it all together:
- I used Freeform to make the window
- I took code from Alyce Watson, Lazman (freeware) to select folders in stead of files
- I slightly changed the recursive code from Brad (he is the editor of this Newsletter)
- I used the recursive code twice. The first time just to calculate the total amount of MB's of all the files in the source folder. The second time I am collecting the files one by one to copy them to the destination folder.
- I looked at all the other simulators.
While the other simulators are focused on displaying a bar in a window at some preset pace, I concentrated on copying folders.
My simulator can be extended with user selection of the source folder in stead of the fixed default folder that my program uses. The program can also get improved by putting a routine to remove the read only file attribute from each copied file. This is very useful when the program should copy file from a CD.
'Progress simulator
'Gordon Rahman
dim Finfo$(10,3) 'needed by Brad's function
dim FileTree$(2000) 'needed by Brad's function
MaxEntries = 1999 'needed by Brad's function
global totalBytes 'LB4 feature
graphw = 335
'Form created with the help of Freeform 3
'Generated on Nov 19, 2003 at 23:18:37
DestinationPath$ = "C:\Games\Nieuwe map"
[setupMainWindow]
'-----Begin main GUI window code
nomainwin
WindowWidth = 400
WindowHeight = 450
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "buttonface"
ForegroundColor$ = "black"
'-----Begin GUI objects code
TextboxColor$ = "white"
'
'-----------\
'FIRST ARROW >
'-----------/
groupbox #main.groupbox2, "Default Destination Folder", 15, 237, 365, 95
groupbox #main.groupbox3, "Status", 15, 237, 365, 95
textbox #main.textbox1, 30, 272, graphw, 25
graphicbox #main.graphbox1, 30, 272, graphw, 25
button #main.button3, "Start", [button3Click], UL, 130, 382, 105, 25
button #main.button4, "Exit", [exit], UL, 260, 382, 105, 25
statictext #main.statictext3, "Source Folder", 10, 40, 200, 20
statictext #main.statictext4, "Destination Folder", 10, 140, 200, 20
statictext #main.statictext5, "", 10, 60, 385, 30
statictext #main.statictext6, "", 10, 160, 385, 30
statictext #main.statictext7, "", 30, 300, 200, 20
button #main.button8, "Browse", [browse], UL, 260, 302, 105, 25
'-----End GUI objects code
open "XCOPY" for window as #main
print #main, "font ms_sans_serif 0 16"
'------------\
'SECOND ARROW >
'------------/
print #main.statictext3, "!font arial 14 italic"
print #main.statictext4, "!font arial 14 italic"
print #main, "trapclose [quit]"
print #main.graphbox1, "fill white"
print #main.groupbox3, "!hide"
print #main.graphbox1, "hide"
print #main.textbox1, DestinationPath$
The window below was created with Freeform. Both day and time stamps at generating are still attached. So there is little more left to add to it. Let's concentrate on the two arrows I placed in the code.
- The first arrow points to the fact that the two groupboxes contain the same arguments (X and Y coordinates, length and width) , which means that the first box will only show a short time before the next box overwrites it.
- The second arrow emphasizes a new feature of Liberty Basic. This LB4 feature imposes us to change the font on a control only.
The following part of this snippet gives room for improvement. As stated here the program will use the default directory that Windows uses currently. The variable sPath$ is than used as parameter in the function called Entries.
sPath$ = DefaultDir$ + "\" 'change the default dir (source dir) here
One of the first actions the program does is to measure the size of all the files found in the source folder and all its sub directories. To find the number of files in the source folder and count their sizes I asked at the forum for the API routine to do this. It is good thing that nobody answered my plea, because I found the routine lying inside the LB4 directory. It only states a title "get the size of a folder" and is named "foldersize.bas". I discovered it at Liberty Belle.
At last I used the routine to find all the files in a folder. I combined this with the FILES command (info$(x,1) I found in the help files. Therefore I introduced the variable totalBytes.
The variable totalBytes is reset to zero to begin with and must be a global variable. Global variables can be used (change value) inside functions. Then user function for Entries=FileTree( with 8 parameters) is called for the first time. This function is made by the editor of this Newsletter, Brad Moore as I said before.
totalBytes = 0
Entries = FileTree(MaxEntries, 0, 0, sPath$, 24, 1, 1, 1)
totalBytes = int(totalBytes/1000000)
#main.statictext7, "Required: " + str$(totalBytes) + " MB"
[main.inputLoop] 'wait here for input event
wait
[exit] 'Perform action for the button named 'button4'
[quit] 'Same action to End the program
close #main
end
This is the end of the main loop of the snippet. What follows is a call to a user DLL to open a "folderdialog window" so to speak. After that there is the routine to actually copy the files from one place to another. And at last the function of Brad Moore.
When we issue the browse button this will trigger this piece of code. This piece of code is wide spread and freeware. I came across it at several places. I only marked the text on two locations where I replaced the standard text. As the routine comes with a lot of remarks, it's not necessary to repeat or shed more light on it.
'--------------------------------------------------------------
[browse] 'Perform action for the button named 'Browse'
'Folders browse I found in Mastering Liberty Basic made by Brent, Alyce, many others
'I have seen this routine at several places
'The following Function is courtesy Lazman (with help from Alyce)
'It opens a system window and allows the use to search for and select a
'folder, not a file like what is possible with the FILEDIALOG command
BIF.RETURNONLYFSDIRS = 1
BIF.USENEWUI = hexdec("40")
MAX.PATH = 260
crlf$=chr$(13)+chr$(10)
'Create structure for API call
STRUCT BrowseInfo,_
hWndOwner As Long,_
pIDLRoot As Long,_
pszDisplayName As Long,_
lpszTitle$ As ptr,_
ulFlags As Long,_
lpfnCallback As Long,_
lParam As Long,_
iImage As Long
'Set the owner window, optional
BrowseInfo.hWndOwner.struct = 0
'Set up text to display on the dialog:
txt1$="Select folder for the application." + crlf$
txt1$=txt1$+DefaultDir$ +" will be added to this folder"
'Fill the struct item with the text
BrowseInfo.lpszTitle$.struct = txt1$
'Return only if the user selected a directory
'BrowseInfo.ulFlags.struct = BIF.RETURNONLYFSDIRS
BrowseInfo.ulFlags.struct = BIF.RETURNONLYFSDIRS or BIF.USENEWUI
'Show the 'Browse for folder' dialog
calldll #shell32, "SHBrowseForFolder",_
BrowseInfo as struct,_
lpIDList as long
'return > 0 = success, so continue
If lpIDList>0 Then
'Set up a string buffer:
sPath$ = space$(MAX.PATH) + chr$(0)
'Get the path from the IDList
calldll #shell32, "SHGetPathFromIDList",_
lpIDList as long,_
sPath$ as ptr,_
r as long
This is what this piece of code produces on my computer.
'The folder name is now in sPath$
Open "ole32" for dll as #ole
'Free the block of memory
calldll #ole, "CoTaskMemFree",_
lpIDList as long,_
r as long
close #ole
'Check for null char, which
'Signals end of folder name string
iNull = InStr(sPath$, chr$(0))
'Truncate string at null character
If iNull Then
sPath$ = Left$(sPath$, iNull - 1)
End If
End If
DestinationPath$ = sPath$
'If user cancelled, sPath$ is empty
if DestinationPath$="" then wait
print #main.textbox1, DestinationPath$
wait
'Now cause Explorer to open in that folder
call ShellExecute 0, sPath$,_SW_SHOWNA, "explore"
end
Sub ShellExecute hWnd, file$, parameter, lpszOp$
' _SW_SHOWNA show normal
' _SW_HIDE hide window
' _SW_MINIMIZE minimize window
' lpszOp$ = "open" or "print" or "explore"
lpszFile$ = file$
lpszDir$ = DefaultDir$
lpszParams$=""
CallDLL #shell32, "ShellExecuteA", hWnd As long,_
lpszOp$ As ptr,lpszFile$ As ptr,_
lpszParams$ As ptr,lpszDir$ As ptr,_
parameter As long, result As long
End Sub
wait
'-------------------------------------------------------------
The most important function of this simulator is the routine to find all files in a folder and to copy them. I used the MSDOS function XCOPY to do the same. XCOPY has some disadvantages. When it runs, it will show the black MSDOS window even if you use the @ECHO OFF batch statement. Of course HIDE WINDOW is a windows command that doesn't work in the MSDOS environment.
The function for finding files in folders is well documented. FileTree(MaxEntries,CurrentEntry,CurrentLevel,sPath$,txLen,Tree,Subdirs,SortKey)
You need to provide a maximum number of entries the routine will meet. In this case I used MaxEntries=1999 as Brad suggested that too in his example. I'll come back to this function again later on.
The screenshot above is just there to breakdown the text a little. It is a shot from some installer I wrote that uses Brad's routine too. This installer can be found in Newsletter #111
[button3Click] 'Perform action for the button named 'Start'
sPath$ = DefaultDir$ + "\" 'change defaultdir (source dir) here
#main.textbox1, "!hide"
#main.graphbox1, "show"
#main.groupbox2, "!hide"
#main.groupbox3, "!show"
Entries = FileTree(MaxEntries, 0, 0, sPath$, 24, 1, 1, 1)
After visiting the function we receive the number of entries and the accompanying file name for each entry. With this Entries I can calculate nlines to use in my graphical display.
If Entries > 0 Then
nlines = (graphw/Entries)
For x = 0 to Entries '-1 'just - 1 Brad?
fName$ = FileTree$(x)
nName$ = DestinationPath$ + right$(fName$,len(fName$)-2)
tName$ = nName$
for t = 1 to len(tName$)
if mid$(tName$,t,1) <> "\" then goto [nu]
result = mkdir((left$(tName$,t)))
'print result
'result 5 means Drive exists
'result 183 means Folder already exists
'result 3 means ERROR
'result 0 means Folder created
[nu] next t
cursor hourglass
'The last fName$ = "" so...
if fName$ = "" then nName$ = ""
print #main.statictext6, nName$
print #main.statictext5, fName$
Here comes the graphical calculation. A box of newx length is filled with the colour green every time a file is being copied.
newx = nlines * x
print #main.graphbox1, "backcolor green"
print #main.graphbox1, "place 0 0"
print #main.graphbox1, "down"
print #main.graphbox1, "boxfilled ";newx;" 25"
'API call to copy a file to a directory
'This does the same as LB's command NAME
'-----------------------------------
'Calldll #kernel32, "CopyFileA",_
'fName$ as ptr,_
'nName$ as ptr,_
'bFailIfSucceed as long,_
'ret as long
'-----------------------------------
for TiMe = 1 to int(rnd(1)*1000) : next TiMe 'to simulate copy
cursor normal
Next x
End If
notice "Everything Installed"
wait
'-------------------------------------------------------------
The next routine is from Brad Moore.
Thanks Brad. BTW shouldn't the x run to Entries - 1?
The last of the Entries is void.
Recursive function by Brad Moore
'Arguments:
'----------
'MaxEntries is the maximum number of entries permitted in the array
' FileTree$(x). It is the value of x, the size of array.
'CurrentEntry is the current element in the array that was LAST
' populated. It is used as a pointer to load the next array element.
' When the function is first called this value is zero.
'CurrentLevel is the relative level in the directory structure
' that we are at compared with the original level called -
' this is always set to zero when the function is called.
'Path$ is the directory path to the directory we are creating
' a tree for.
'txLen is the value representing the number of MAX characters filename
' strings can hold. The default (if zero is passed) is 15
'Tree and Subdirs are both Boolean switches. Set Tree = 1 if you
' want the function to traverse the whole directory tree (i.e. list
' all files in directory and subdirectories). Any other value will
' disable this feature.
' Set Subdirs = 1 if you want the function to print subdirectry names
' along with the filenames. Any other value will disable this feature.
'SortKey is used to specify whether to sort files by name or size. Set to
' value of 1 to sort by name, any other value will cause a sort by size.
'
'Return Value:
'-------------
'The function returns the latest entry that a value was written
' into. If after calling the function it returns with zero you
' know that no files or subdirectories exist.
Function FileTree(MaxEntries,CurrentEntry,CurrentLevel,sPath$,txLen,Tree,Subdirs,SortKey)
If txLen = 0 Then txLen = 15
If sPath$ = "" or MaxEntries = 0 Then
FileTree$(1) = "Error - Path is blank or MaxEntries = 0: Can't continue"
CurrentEntry = 1
Else
If CurrentEntry + 1 < MaxEntries Then
Files sPath$, "*.*", Finfo$()
qtyFiles = Val(Finfo$(0, 0))
qtySubDirs = Val(Finfo$(0, 1))
'Now we will process the files on this level (of recursion)
If qtyFiles > 0 Then
For x = qtyFiles to 1 step -1
FileTree$(CurrentEntry) = sPath$ + Finfo$(x,0)
'Insure there is room for the next entry
totalBytes = totalBytes + val(Finfo$(x,1))
CurrentEntry = CurrentEntry + 1
If CurrentEntry >= MaxEntries Then Exit For
Next x
End If
'Recurse any subdirectories if there are any and if Tree flag is set to one.
If qtySubDirs > 0 and Tree = 1 Then
x = 1
[FileTree.Loop]
Files sPath$, "*.*", Finfo$()
qtyFiles = Val(Finfo$(0, 0))
qtySubDirs = Val(Finfo$(0, 1))
If Right$(sPath$,1) <> "\" Then sPath$ = sPath$ + "\"
NewPath$ = sPath$ + Finfo$(x+qtyFiles,1) + "\"
'call FileTree recursively
CurrentEntry = FileTree(MaxEntries, CurrentEntry, _
CurrentLevel+1, NewPath$, txLen, Tree, Subdirs, SortKey)
'Increment our counter that tracks which endicy we are on...
x = x + 1
If x <= qtySubDirs AND CurrentEntry+1 < MaxEntries Then GoTo [FileTree.Loop]
End If
End If
End If
FileTree = CurrentEntry
End Function